home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / qbtree45.zip / TEST45.BAS < prev    next >
BASIC Source File  |  1991-01-03  |  9KB  |  270 lines
  1. DECLARE FUNCTION ErrorReport$ (status%)
  2. DECLARE FUNCTION DoInit% (dat0file$, key0file$, key1file$)
  3. DECLARE FUNCTION GetKey% (waitfor%)
  4. '{QBTREE version 4.50 short example 01/02/91}
  5. REM $INCLUDE: 'c:\prg\qb\bi\qbtree45.bi'
  6. DEFINT A-Z
  7. CONST CREATE = -1, KEYMAX = 19
  8.  
  9. dat0file$ = "DAT0.45"
  10. key0file$ = "KEY0.45"
  11. key1file$ = "KEY1.45"
  12. errc = DoInit(dat0file$, key0file$, key1file$)
  13. IF NOT errc THEN
  14.    DO WHILE errc$ = ""
  15.       qkey$ = LEFT$(STR$(1& * RND * TIMER), 7)
  16.       qkey0$ = qkey$ + "0"
  17.       qkey1$ = qkey$ + "1"
  18.       qdat$ = "DATA/" + qkey$ + "/REC"
  19.       PRINT "Adding keyrecord:"; qkey0$; "  data:"; qdat$;
  20.       errc$ = ErrorReport$(AddRecord(0, 0, qkey0$, qdat$))
  21.       IF errc$ = "" THEN
  22.          PRINT "     Putting key:"; qkey1$;
  23.          errc$ = ErrorReport$(PutKey(1, 0, qkey1$))
  24.       END IF
  25.       IF errc$ <> "" THEN SLEEP 2
  26.       cnt = cnt + 1: IF cnt > KEYMAX THEN EXIT DO
  27.    LOOP
  28.    PRINT
  29.    INPUT "Press <Enter> to view keyed data", a$
  30.    CLS
  31.    errc = QBTreeVer(ver)
  32.    PRINT "QBTREE"; ver; "SAMPLE PROGRAM"
  33.    PRINT "STAT:                                   STAT:"
  34.    PRINT "KEY0:                                   KEY1:"
  35.    PRINT " DAT:                                    DAT:"
  36.    errc = GetFirst(0, 0, qkey0$, qdat$)
  37.    t$ = ErrorReport$(errc): LOCATE 2, 7: PRINT t$ + SPACE$(34 - LEN(t$))
  38.    LOCATE 3, 6: PRINT qkey0$: LOCATE 4, 7: PRINT qdat$;
  39.    errc = GetPosition(0, recno&): PRINT recno&; "   "
  40.    errc = GetFirst(1, 0, qkey1$, qdat$)
  41.    t$ = ErrorReport$(errc): LOCATE 2, 47: PRINT t$ + SPACE$(33 - LEN(t$))
  42.    LOCATE 3, 46: PRINT qkey1$: LOCATE 4, 47: PRINT qdat$;
  43.    errc = GetPosition(1, recno&): PRINT recno&; "   "
  44.    kfile = 0
  45.    LOCATE 4, 1: PRINT "*": LOCATE 4, 41: PRINT " "
  46.    DO
  47.       akey = GetKey(0)
  48.       SELECT CASE akey
  49.       CASE 0
  50.       CASE 1072, 56 'up
  51.          kfile = 1
  52.          LOCATE 4, 1: PRINT " ": LOCATE 4, 41: PRINT "*"
  53.       CASE 1080, 50 'down
  54.          kfile = 0
  55.          LOCATE 4, 1: PRINT "*": LOCATE 4, 41: PRINT " "
  56.       CASE 1077, 54 'right
  57.          IF kfile = 0 THEN
  58.             errc = GetNext(0, 0, qkey0$, qdat$)
  59.             t$ = ErrorReport$(errc): LOCATE 2, 7: PRINT t$ + SPACE$(34 - LEN(t$))
  60.             LOCATE 3, 6: PRINT qkey0$: LOCATE 4, 7: PRINT qdat$;
  61.             errc = GetPosition(0, recno&): PRINT recno&; "   "
  62.          ELSE
  63.             errc = GetNext(1, 0, qkey1$, qdat$)
  64.             t$ = ErrorReport$(errc): LOCATE 2, 47: PRINT t$ + SPACE$(33 - LEN(t$))
  65.             LOCATE 3, 46: PRINT qkey1$: LOCATE 4, 47: PRINT qdat$;
  66.             errc = GetPosition(1, recno&): PRINT recno&; "   "
  67.          END IF
  68.       CASE 1075, 52 'left
  69.          IF kfile = 0 THEN
  70.             errc = GetPrev(0, 0, qkey0$, qdat$)
  71.             t$ = ErrorReport$(errc): LOCATE 2, 7: PRINT t$ + SPACE$(34 - LEN(t$))
  72.             LOCATE 3, 6: PRINT qkey0$: LOCATE 4, 7: PRINT qdat$;
  73.             errc = GetPosition(0, recno&): PRINT recno&; "   "
  74.          ELSE
  75.             errc = GetPrev(1, 0, qkey1$, qdat$)
  76.             t$ = ErrorReport$(errc): LOCATE 2, 47: PRINT t$ + SPACE$(33 - LEN(t$))
  77.             LOCATE 3, 46: PRINT qkey1$: LOCATE 4, 47: PRINT qdat$;
  78.             errc = GetPosition(1, recno&): PRINT recno&; "   "
  79.          END IF
  80.       CASE 85, 117 'U-pdate
  81.          IF qdat$ <> "" THEN
  82.             qdat$ = LEFT$(qdat$, LEN(qdat$) - 3) + "UPD"
  83.             errc = UpdateRecord(0, qdat$): IF errc THEN qdat$ = ""
  84.             IF kfile = 0 THEN
  85.                t$ = ErrorReport$(errc): LOCATE 2, 7: PRINT t$ + SPACE$(34 - LEN(t$))
  86.                IF errc = 0 THEN LOCATE 3, 6: PRINT qkey0$: LOCATE 4, 7: PRINT qdat$
  87.             ELSE
  88.                t$ = ErrorReport$(errc): LOCATE 2, 47: PRINT t$ + SPACE$(33 - LEN(t$))
  89.                IF errc = 0 THEN LOCATE 3, 46: PRINT qkey1$: LOCATE 4, 47: PRINT qdat$
  90.             END IF
  91.          END IF
  92.       CASE 68, 100 'D-elete key (not data record)
  93.          IF kfile = 0 THEN
  94.             errc = DeleteKey(0, qkey0$)
  95.             t$ = ErrorReport$(errc): LOCATE 2, 7: PRINT t$ + SPACE$(34 - LEN(t$))
  96.          ELSE
  97.             errc = DeleteKey(1, qkey1$)
  98.             t$ = ErrorReport$(errc): LOCATE 2, 47: PRINT t$ + SPACE$(33 - LEN(t$))
  99.          END IF
  100.       CASE 4       '^D-elete key and record
  101.          IF kfile = 0 THEN
  102.             errc = GetPosition(1, recno&): PRINT recno&; "   "
  103.             errc = DeleteRecord(0, 0, qkey0$)
  104.             t$ = ErrorReport$(errc): LOCATE 2, 7: PRINT t$ + SPACE$(34 - LEN(t$))
  105.          ELSE
  106.             errc = DeleteRecord(1, 0, qkey1$)
  107.             t$ = ErrorReport$(errc): LOCATE 2, 47: PRINT t$ + SPACE$(33 - LEN(t$))
  108.          END IF
  109.       CASE 70, 102 'F-lush
  110.          errc = FlushDataFile(0, 1)
  111.          t$ = ErrorReport$(errc): LOCATE 2, 7: PRINT t$ + SPACE$(34 - LEN(t$))
  112.          errc = FlushKeyFile(0, 1)
  113.          t$ = ErrorReport$(errc): LOCATE 2, 7: PRINT t$ + SPACE$(34 - LEN(t$))
  114.          errc = FlushKeyFile(1, 1)
  115.          t$ = ErrorReport$(errc): LOCATE 2, 47: PRINT t$ + SPACE$(34 - LEN(t$))
  116.       CASE 16 'P-utkey (try at TOF or where last access was an error)
  117.          IF kfile = 0 THEN
  118.             errc = PutKey(0, 0, " E206TST")
  119.             t$ = ErrorReport$(errc): LOCATE 2, 7: PRINT t$ + SPACE$(34 - LEN(t$))
  120.          ELSE
  121.             errc = PutKey(1, 0, " E206TST")
  122.             t$ = ErrorReport$(errc): LOCATE 2, 47: PRINT t$ + SPACE$(34 - LEN(t$))
  123.          END IF
  124.       CASE 26 'Z-status
  125.          IF kfile = 0 THEN
  126.             errc = StatDataFile(0, recl, recs&, df)
  127.             errc = StatKeyFile(0, keyl, keys&, kf)
  128.             LOCATE 5, 2: PRINT "DST:"; recl; recs&; df; "    "
  129.             LOCATE 6, 2: PRINT "KST:"; keyl; keys&; kf; "    "
  130.          ELSE
  131.             errc = StatDataFile(0, recl, recs&, df)
  132.             errc = StatKeyFile(1, keyl, keys&, kf)
  133.             LOCATE 5, 42: PRINT "DST:"; recl; recs&; df; "    "
  134.             LOCATE 6, 42: PRINT "KST:"; keyl; keys&; kf; "    "
  135.          END IF
  136.       CASE 1 '^A
  137.          errc = GetDirect(0, 1, drec$)
  138.          LOCATE 7, 1: PRINT "Direct #1:"; drec$; ErrorReport$(errc)
  139.       CASE ELSE
  140.       END SELECT
  141.    LOOP UNTIL akey = 27
  142.    errc = CloseDataFile(0)
  143.    errc = CloseKeyFile(0)
  144.    errc = CloseKeyFile(1)
  145. END IF
  146. LOCATE 8, 1
  147. PRINT "done."
  148. END
  149.  
  150. FUNCTION DoInit (dat0file$, key0file$, key1file$)
  151. '{create and open the files}
  152.  
  153. VIEW PRINT 1 TO 25: CLS
  154. IF NOT CREATE THEN GOTO skip
  155.  
  156. PRINT "Creating data file #0: " + dat0file$
  157. DO
  158.    errc = CreateDataFile(dat0file$, 16)
  159.    IF errc = 230 THEN KILL dat0file$
  160.    cnt = cnt + 1
  161. LOOP WHILE errc = 230 AND cnt < 2
  162. IF errc THEN DoInit = errc: EXIT FUNCTION
  163.  
  164. PRINT "Creating key file #0: " + key0file$
  165. cnt = 0
  166. DO
  167.    errc = CreateKeyFile(key0file$, 8)
  168.    IF errc = 230 THEN KILL key0file$
  169.    cnt = cnt + 1
  170. LOOP WHILE errc = 230 AND cnt < 2
  171. IF errc THEN DoInit = errc: EXIT FUNCTION
  172.  
  173. PRINT "Creating key file #1: " + key1file$
  174. cnt = 0
  175. DO
  176.    errc = CreateKeyFile(key1file$, 8)
  177.    IF errc = 230 THEN KILL key1file$
  178.    cnt = cnt + 1
  179. LOOP WHILE errc = 230 AND cnt < 2
  180. IF errc THEN DoInit = errc: EXIT FUNCTION
  181.  
  182. skip:
  183. PRINT "Opening key and data files"
  184. errc = OpenDataFile(dat0file$, 0)
  185. t = StatDataFile(0, recl, recs&, bfile)
  186. IF NOT errc THEN errc = OpenKeyFile(key0file$, 0)
  187. t = StatKeyFile(0, keyl, keys&, bfile)
  188. IF NOT errc THEN errc = OpenKeyFile(key1file$, 1)
  189. t = StatKeyFile(1, keyl, keys&, bfile)
  190. DoInit = errc
  191.  
  192. END FUNCTION
  193.  
  194. FUNCTION ErrorReport$ (status)
  195. SELECT CASE status
  196. CASE 0
  197.    t$ = ""
  198. CASE IS < 200
  199.    t$ = "QB ERROR"
  200. CASE 200
  201.    t$ = "KEY NOT FOUND"
  202. CASE 201
  203.    t$ = "KEY ALREADY EXISTS"
  204. CASE 202
  205.    t$ = "END OF FILE"
  206. CASE 203
  207.    t$ = "TOP OF FILE"
  208. CASE 204
  209.    t$ = "EMPTY FILE"
  210. CASE 205
  211.    t$ = "DISK FULL"
  212. CASE 206
  213.    t$ = "DATA POINTER INVALID"
  214. CASE 210
  215.    t$ = "INTERNAL STACK OVERFLOW"
  216. CASE 211
  217.    t$ = "FUNCTION NOT IMPLEMENTED"
  218. CASE 219
  219.    t$ = "INVALID FILE NUMBER"
  220. CASE 220
  221.    t$ = "INVALID DATA RECORD LENGTH"
  222. CASE 221
  223.    t$ = "INVALID KEY LENGTH"
  224. CASE 222
  225.    t$ = "FILE NOT FOUND"
  226. CASE 223
  227.    t$ = "INVALID NULL KEY ASSIGNMENT"
  228. CASE 224
  229.    t$ = "INVALID RECORD NUMBER"
  230. CASE 225
  231.    t$ = "NO HANDLE FOR FLUSH"
  232. CASE 226
  233.    t$ = "INVALID DRIVE"
  234. CASE 228
  235.    t$ = "FILE NOT QBTREE COMPATIBLE"
  236. CASE 229
  237.    t$ = "LOCK ALREADY IN FORCE"
  238. CASE 230
  239.    t$ = "FILE ALREADY EXISTS"
  240. CASE 231
  241.    t$ = "FILE NOT FOUND"
  242. CASE 232
  243.    t$ = "GENERAL LOCK FAILURE"
  244. CASE 207 TO 209, 212 TO 218, 227, 233 TO 255
  245.    t$ = "reserved error"
  246. CASE ELSE
  247. END SELECT
  248. ErrorReport$ = t$
  249.  
  250. END FUNCTION
  251.  
  252. FUNCTION GetKey (waitfor)
  253.  
  254. DO
  255.    a$ = INKEY$
  256.    IF LEN(a$) = 1 THEN
  257.       a = ASC(a$)
  258.    ELSEIF LEN(a$) = 2 THEN
  259.       a = 1000 + ASC(RIGHT$(a$, 1))
  260.    ELSE
  261.       a = 0
  262.    END IF
  263.    IF a THEN LOCATE 6, 75: PRINT a
  264.    IF waitfor = FALSE THEN EXIT DO
  265. LOOP UNTIL a
  266. GetKey = a
  267.  
  268. END FUNCTION
  269.  
  270.